Topic Models

Case study: Telegram Geschwurbel

Introduction

A topic model is a probabilistic model that describes how documents are generated from a given number of topics and how words (or terms) are generated from these topics. In practice, it allows us to find latent (underlying) topics (i.e. clusters of words) in a corpus of many documents – which may help us to get an overview of the documents’ content and its distribution. It also allows us to contrast different types of documents according to their metadata: Are certain topics more prevalent in documents belonging to a specific source (e.g. different media, political parties)? Since topic modeling is a method that reduces the dimensionality of the data (where before you had hundreds or thousands of different words and their frequencies, you now have only a handful of topics), it can also be useful as a preparatory step for supervised machine learning.

Different approaches to topic modelling exist, as well as different implementations in various libraries. To list just some of them:

• Latent Dirichlet allocation (LDA) is perhaps the most widely used method.
• Correlated topic models (CTMs, Blei and Lafferty 2006) are an extension of LDA which relaxes the assumption of independence of topics (so that topics can be correlated). This is often a more realistic assumption, as we’d expect the existence of at least some related topics which co-occur quite often.
• Structural topic models (STMs) are an extension of CTMs that allow the inclusion of document-level metadata. More on that later.
• Gensim is probably the default library for Python. Several algorithms for topic modelling are implemented, e.g. LDA or Hierarchical Dirichlet Process (HDP).
• Keyword-assisted topic models, available via the R package keyATM find some or all topics based on a few user-defined keywords (potentially very useful if you’re interested in more specific topics).
• BERTopic (Python) is a flexible approach to topic modelling that leverages transformers and their better grasp of semantics.

Here, we’ll try our hand at a structural topic model for Telegram posts made in conspiracy or conspiracy-adjacent channels and chat groups during the Corona crisis.

Setup

library(tidyverse)
library(reticulate)
library(quanteda)
library(tidytext)
library(stm)

First things first. We’ll need to:

• read in the data
• clean it
• tokenise all texts
• optionally annotate them (e.g. POS tagging)
• remove unneeded or unwanted tokens (both rare and ubiquitous terms)
• construct a document-term matrix
• construct a topic model
• evaluate and interpret it
• possibly repeat/adjust some of the above steps to arrive at a better model

Data

We’ll use our Telegram sample:

train <- read_csv("../data/geschwurbel/train.csv")
dev <- read_csv("../data/geschwurbel/dev.csv")
test <- read_csv("../data/geschwurbel/test.csv")

New column: Geschwurbel as a factor (ja or nein):

train <- train |> mutate(Geschwurbel = factor(kein_Geschwurbel, labels = c("ja", "nein")))
dev <- dev |> mutate(Geschwurbel = factor(kein_Geschwurbel, labels = c("ja", "nein")))
test <- test |> mutate(Geschwurbel = factor(kein_Geschwurbel, labels = c("ja", "nein")))

Since we’re not doing supervised learning here, let’s combine all three datasets into one:

all <- bind_rows(train, dev, test) |>
  select(id, channel, Geschwurbel, text) |>
  arrange(id)

Normalise text in one weird post:

all |> filter(id == 645) |> pull(text)

[1] "𝙳𝚒𝚎 𝙱𝚒𝚍𝚎𝚗-𝚁𝚎𝚐𝚒𝚎𝚛𝚞𝚗𝚐 𝚠𝚒𝚛𝚍 𝚠𝚎𝚐𝚎𝚗 𝚎𝚒𝚗𝚎𝚛 𝚗𝚎𝚞𝚎𝚗 𝙴𝚡𝚎𝚔𝚞𝚝𝚒𝚟-𝙰𝚗𝚘𝚛𝚍𝚗𝚞𝚗𝚐 𝚟𝚎𝚛𝚔𝚕𝚊𝚐𝚝. 𝙳𝚒𝚎𝚜𝚎 𝚜𝚘𝚕𝚕 𝚍𝚒𝚎 „Ö𝚕- 𝚞𝚗𝚍 𝙶𝚊𝚜𝚋𝚘𝚑𝚛𝚞𝚗𝚐𝚎𝚗“ 𝚊𝚗 𝙻𝚊𝚗𝚍 𝚞𝚗𝚍 𝚒𝚗 𝙶𝚎𝚠ä𝚜𝚜𝚎𝚛𝚗 𝚜𝚝𝚘𝚙𝚙𝚎𝚗. 𝚄𝚂-𝙿𝚛ä𝚜𝚒𝚍𝚎𝚗𝚝 𝙹𝚘𝚎 𝙱𝚒𝚍𝚎𝚗 𝚊𝚗𝚗𝚞𝚕𝚕𝚒𝚎𝚛𝚝𝚎 𝚐𝚕𝚎𝚒𝚌𝚑 𝚊𝚖 𝚎𝚛𝚜𝚝𝚎𝚗 𝚃𝚊𝚐 𝚒𝚖 𝙰𝚖𝚝 𝚍𝚒𝚎 𝙶𝚎𝚗𝚎𝚑𝚖𝚒𝚐𝚞𝚗𝚐 𝚏ü𝚛 𝚍𝚒𝚎 𝙺𝚎𝚢𝚜𝚝𝚘𝚗𝚎 𝚇𝙻 𝙿𝚒𝚙𝚎𝚕𝚒𝚗𝚎. 𝙳𝚒𝚎 𝚄𝚖𝚠𝚎𝚕𝚝𝚜𝚌𝚑ü𝚝𝚣𝚎𝚛 𝚋𝚎𝚓𝚞𝚋𝚎𝚕𝚗 𝚜𝚎𝚒𝚗𝚎 𝙴𝚗𝚝𝚜𝚌𝚑𝚎𝚒𝚍𝚞𝚗𝚐. 𝙳𝚘𝚌𝚑 𝚎𝚝𝚕𝚒𝚌𝚑𝚎 𝙰𝚛𝚋𝚎𝚒𝚝𝚜𝚙𝚕ä𝚝𝚣𝚎 𝚐𝚎𝚑𝚎𝚗 𝚍𝚊𝚖𝚒𝚝 𝚎𝚋𝚎𝚗𝚜𝚘 𝚟𝚎𝚛𝚕𝚘𝚛𝚎𝚗. 𝙹𝚎𝚝𝚣𝚝 𝚖𝚎𝚕𝚍𝚎𝚗 𝚜𝚒𝚌𝚑 𝚍𝚒𝚎 𝙱𝚎𝚝𝚛𝚘𝚏𝚏𝚎𝚗𝚎𝚗 𝚣𝚞 𝚆𝚘𝚛𝚝. https://www.youtube.com/watch?v=8Nr7BAhzQXI https://t.me/epochtimesde"

all <- all |>
  mutate(text = ifelse(id == 645, stringi::stri_trans_nfkc(text), text))

all |> filter(id == 645) |> pull(text)

[1] "Die Biden-Regierung wird wegen einer neuen Exekutiv-Anordnung verklagt. Diese soll die „Öl- und Gasbohrungen“ an Land und in Gewässern stoppen. US-Präsident Joe Biden annullierte gleich am ersten Tag im Amt die Genehmigung für die Keystone XL Pipeline. Die Umweltschützer bejubeln seine Entscheidung. Doch etliche Arbeitsplätze gehen damit ebenso verloren. Jetzt melden sich die Betroffenen zu Wort. https://www.youtube.com/watch?v=8Nr7BAhzQXI https://t.me/epochtimesde"

Unescape XML entities (e.g. & -> &):

unescape_xml <- Vectorize(function(str){
  xml2::xml_text(xml2::read_xml(paste0("<x>", str, "</x>")))
})

all <- all |>
  mutate(text = unescape_xml(text))

Replace all URLs with the string “URL”:

tlds <- read_csv("https://data.iana.org/TLD/tlds-alpha-by-domain.txt", col_names = "tld", skip = 1) # list of current top-level domains (like .com, .de or .org)
tlds <- tlds |>
  mutate(tld = str_to_lower(tld)) |>
  filter(!str_detect(tld, "^xn--"))
tld_re <- tlds$tld |> str_flatten("|")

all <- all |>
  mutate(
    text = str_replace_all(
      text,
      regex(
        str_c(
          r"(\b(https?://)?(www\.)?(\w[\w-]*\.)*?(\w[\w-]*\.)()",
          tld_re,
          r"()(/\S*)?(?=\s|[.!?]|$))"
        ),
        ignore_case = TRUE
      ),
      "URL"
    )
  )

Tokenisation and tagging in Python

We could tokenise and tag everything in R, as we’ve done before. This time, though, let’s use Python instead.

Quarto supports code chunks in different languages – so including Python code is easy. You need to configure your Python interpreter in your global or project settings, however!

To access R objects in Python and vice versa, the reticulate package is used. To access an object from your R environment, simply use r. in front of its name (data.frames/tibbles are automatically converted to pandas-DataFrames). Likewise, to access Python objects in R, we’ll use py$.

df = r.all

df

          id  ...                                               text
0        0.0  ...  Es ist schon seit einiger Zeit schwierig für m...
1        1.0  ...  Wieder mal ein sehr perpetuierendes Video der ...
2        2.0  ...  🆔Nubi URL ¯\_(ツ)_/¯: ❄❄#OpSafeWinter 2019/2020...
3        3.0  ...  Nachtrag zum #YouTubeStreik Die Aktion war ein...
4        4.0  ...  „Generieren“ von “Wunschpublikum“ "Zufälle gib...
...      ...  ...                                                ...
1094  1098.0  ...  🙏🙏🥳 3 ..2...1.. könnte jetzt schnell gehen. Di...
1095  1099.0  ...  Konzentriert euch bitte auf die Widerlegung de...
1096  1100.0  ...  Sprich, Putin darf jeden über den Haufen schie...
1097  1101.0  ...  Das Feuer wird täglich grösser entfacht‼️US- A...
1098  1102.0  ...  Richter blockiert Freigabe der Autopsiebericht...

[1099 rows x 4 columns]

Now that we have the data in Python, we can use SoMaJo to tokenise our texts. We’ll also use SoMeWeTa to assign POS tags to each token. (Of course, we could also use Trankit, Stanza or spaCy to tokenise and annotate our data instead.)

import pandas as pd
from somajo import SoMaJo
import someweta

model = "../data/german_cmc_wo_ono_2021-04-06.model"
asptagger = someweta.ASPTagger()
asptagger.load(model) # may take some time

tokenizer = SoMaJo("de_CMC") # model for German web and social media text

def annotate(text_column: pd.Series) -> tuple[list, list]:
  token_list = []
  tag_list = []
  
  for text in text_column:
    text = text.strip()
    sentences = tokenizer.tokenize_text(text.split("\n\n")) # tokenize_text expects a list of paragraphs
    # tokens = [token.text for s in sentences for token in s]
    
    s_tokens = []
    s_tags = []
    
    for sentence in sentences:
      tokens = [token.text for token in sentence]
      tagged_sentence = asptagger.tag_sentence(tokens)
      tags = [tag for token, tag in tagged_sentence]
      s_tokens.append(tokens)
      s_tags.append(tags)
      
    token_list.append(s_tokens)
    tag_list.append(s_tags)
    
  return(token_list, tag_list)


df["tokens"], df["tags"] = annotate(df["text"])

The result can now be used in R. The new columns are lists of lists, however (since texts contain sentences which contain individual tokens).

py$df |> select(-text)

To unpack these lists, we can use unnest():

all_tagged <- py$df |>
  select(id, channel, tokens, tags) |>
  unnest(cols = tokens:tags) |> # unnest texts
  mutate(sid = 1:n(), .by = "id") |> # add sentence ids by text
  unnest(cols = tokens:tags) |> # unnest sentences within texts
  select(id, channel, sid, token = tokens, pos = tags)
all_tagged

Filtering

We can now filter by POS tags – since we’re only interested in content words, we’ll only keep nouns, adjectives and lexical verbs. (We could also include TRUNC for truncated words.) Since hashtags can be considered content words as well, we’ll include these, too (but we’ll remove the hash symbols).

If we also want to include words tagged FM (foreign material, in our case usually English), we should use a stopword list.

all_tagged_filtered <- all_tagged |>
  filter(str_detect(pos, "^(N.|ADJ.|VV.+|HST|EMO(ASC|IMG))$") | (pos == "FM" & !token %in% stopwords::stopwords("en"))) |>
  filter(!str_detect(token, r"(^(URL|[[:alpha:]]\.|[[:punct:][0-9]]+)$)")) |>
  mutate(token = str_remove(token, "(^[-#])|(-$)") |> str_to_lower())
all_tagged_filtered

Document-term matrix

The input for most topic models is a document-term matrix (DTM). Luckily, we know how to create these by now.

A DTM can come in different formats in R. tidytext provides several functions for these: cast_sparse() creates a sparse matrix from the Matrix package, cast_dtm() creates a DTM from the tm package (the required input for topicmodels::LDA() and topicmodels::CTM()), and cast_dfm() creates a DTM from the quanteda package. The function for structural topic models which we’re going to use (stm()) works with either a sparse matrix, a quanteda DTM or its own preferred format – we can use quanteda::convert(to = "stm") for this.

counts <- all_tagged_filtered |>
  count(id, token) |>
  add_count(token, name = "df")

# Trimming:
counts <- counts |>
  filter(df <= .5 * nrow(all), # exclude tokens occurring in over 50% of documents
         df > .01 * nrow(all)) # exclude tokens occurring in under 1% of documents (if we had lemmatised our texts, we could keep more of the important terms)

# Sparse matrix:
dfm <- counts |>
  cast_sparse(id, token, n)

# If you want stm's format (useful for some functions):
dfm_stm <- counts |>
  cast_dfm(id, token, n) |>
  quanteda::convert(to = "stm")
docs <- dfm_stm$documents
vocab <- dfm_stm$vocab

Topic model

As said in the introduction, a topic model describes how both documents and terms are generated from topics. Whether you use LDA, correlated topic models or structural topic models, each document is assumed to be a mixture of different topics, and the chosen model has to estimate two matrices simultaneously: - a matrix of per-term-per-topic probabilities \(\beta\) (or word-topic matrix); i.e. the conditional probability of a term (or word) appearing within a specific topic - a matrix of per-document-per-topic probabilities \(\gamma\) (or document-topic matrix); i.e. the conditional probability (or proportion) of a topic within a specific document

Instead of the standard topic modelling library topicmodels, we’ll use stm, a package for structural topic models (see Roberts et al. 2019, which is also the package vignette). This allows us to factor document metadata into the model, e.g. interesting groups of documents. As the authors put it (p. 2):

The goal of the structural topic model is to allow researchers to discover topics and estimate their relationship to document metadata. Outputs of the model can be used to conduct hypothesis testing about these relationships.

STMs allow covariates, namely topical prevalence covariates (i.e. metadata that explain how much of a document is associated with a specific topic or how often a topic is discussed) and topical content covariates (i.e. metadata that explain which words are used within a topic or how it is discussed). An STM without such covariates is basically a correlated topic model (CTM).

The downside of STMs is that they are computationally more expensive – so you may run into trouble when using large amounts of documents with a huge vocabulary (you can always thin your document-term matrix, of course).

Covariates

In our case, we only have the channel names as additional metadata (we could also use the manual classification, but that doesn’t seem right for an unsupervised approach):

covariates <- all |>
  select(id, channel, Geschwurbel) |>
  filter(id %in% counts$id) # make sure to include only the remaining documents

Structural topic model

For the actual model, we’ll need stm(). This function’s main input is a document-term matrix (in our case, a sparse matrix, but you can also use stm’s native format or a dfm object from the quanteda package). The most important model parameter is the number of topics K – the higher you set this, the more fine-grained the topics will be. There are no general rules on how to determine the “right” number of topics. It depends on the number of documents in the corpus, their lengths and their expected similarity. For example, you should expect whole novels to include many more different topics than short tweets. Similarly, a high number of topics is likely appropriate for a corpus of thousands upon thousands of documents, whereas fewer than 20 topics may suffice for a few houndred documents. This is a matter of experimentation.

You can also supply metadata via the data argument and tell the model which of the metadata variables to use as predictors for topical prevalence (argument prevalence) and/or topical content (argument content). init.type = "Spectral" makes the model deterministic (you’ll always get the same result). Instead, you can also use "LDA" for non-deterministic initialisation (to make the results reproducible, you can then set the seed parameter to a number of your choice).

If you use the spectral algorithm and set K to 0, the number of topics is estimated automatically (requires the following packages to be installed: Rtsne, rsvd and geometry). While this probably won’t provide an “ideal” solution, it may be a good place to start. (For our data here, we’d get 48 topics, which seems a little excessive.)

schwurbel_stm <- stm(documents = docs,
                     vocab = vocab, # instead of documents and vocab, a single sparse matrix or quanteda dfm is also possible
                     K = 16, # number of topics
                     data = covariates,
                     prevalence = ~ channel,
                     verbose = FALSE,
                     init.type = "Spectral")

Topics

To get an overview of the topics, we can use the summary() function (or labelTopics()):

summary(schwurbel_stm)

A topic model with 16 topics, 1098 documents and a 952 word dictionary.

Topic 1 Top Words:
     Highest Prob: ‼️, 👇, 😂, einfach, 🥳, interview, braucht 
     FREX: 👇, 😂, ‼️, beiträge, braucht, widerstand, schön 
     Lift: 👇, 😂, beiträge, schön, instagram, platz, ‼️ 
     Score: 👇, 😂, ‼️, 🥳, medizin, schön, instagram 
Topic 2 Top Words:
     Highest Prob: ♦️, ⬇️, uhr, abonniert, kanal, ‼️, ❓ 
     FREX: ♦️, ⬇️, abonniert, uhr, ❓, kanal, 😉 
     Lift: ♦️, ⬇️, abonniert, ❓, uhr, kunden, kanal 
     Score: ♦️, ⬇️, uhr, abonniert, kanal, 🥳, ❓ 
Topic 3 Top Words:
     Highest Prob: medien, frau, video, neuen, welt, gates, herr 
     FREX: frau, medien, gates, bilder, herr, bill, bericht 
     Lift: bill, sozialen, gates, bilder, frau, google, zeitung 
     Score: bill, gates, medien, bilder, frau, video, herr 
Topic 4 Top Words:
     Highest Prob: 👉, link, ✅, übersicht, c, g, corona 
     FREX: 👉, link, übersicht, ✅, g, hauptkanal, c 
     Lift: übersicht, 👉, link, hauptkanal, ✅, g, c 
     Score: 👉, link, übersicht, ✅, c, hauptkanal, 💫 
Topic 5 Top Words:
     Highest Prob: virus, impfung, menschen, pandemie, impfen, impfstoff, covid-19 
     FREX: virus, impfung, geimpft, impfen, impfstoff, pandemie, impfstoffe 
     Lift: geimpft, wissenschaftlichen, analyse, impfung, impfen, grippe, virus 
     Score: impfung, virus, wissenschaftlichen, impfen, impfstoff, impfstoffe, geimpft 
Topic 6 Top Words:
     Highest Prob: maßnahmen, zahlen, bevölkerung, lassen, prozent, bürger, tests 
     FREX: maßnahmen, tests, massiv, zahlen, kritik, bevölkerung, bereich 
     Lift: bestimmte, freundlichen, grüßen, massiv, notwendig, bereich, maßnahmen 
     Score: bestimmte, maßnahmen, tests, zahlen, prozent, bereich, massiv 
Topic 7 Top Words:
     Highest Prob: trump, 🙏, 💥, q, biden, 💫, donald 
     FREX: q, trump, donald, biden, 💚, 🙏, 😘 
     Lift: 💚, patrioten, show, q, donald, state, biden 
     Score: 💫, trump, biden, show, 🙏, 💥, donald 
Topic 8 Top Words:
     Highest Prob: land, deutschen, deutschland, usa, polizei, deutsche, krieg 
     FREX: deutschen, land, krieg, usa, polizei, länder, frankreich 
     Lift: militär, krieg, land, deutschen, putin, männer, länder 
     Score: militär, land, polizei, usa, deutschen, krieg, partei 
Topic 9 Top Words:
     Highest Prob: dr., kinder, maske, tragen, eltern, masken, kindern 
     FREX: dr., kinder, tragen, masken, maske, eltern, prof. 
     Lift: drosten, dr., masken, tragen, maske, prof., kinder 
     Score: dr., kinder, maske, drosten, prof., masken, schule 
Topic 10 Top Words:
     Highest Prob: vitamin, gesundheit, aufklärung, heilung, menschen, holistische, 🎬 
     FREX: vitamin, heilung, holistische, 🎬, aufklärung, gesundheit, 🌎 
     Lift: vitamin, 🌎, heilung, holistische, 🌴, 🎬, aufklärung 
     Score: vitamin, holistische, heilung, 🎬, 🌴, 🌎, gesundheit 
Topic 11 Top Words:
     Highest Prob: china, nachrichten, aktuelle, times, merkel, epoch, deutschland 
     FREX: china, redaktion, epoch, times, vereinigten, nachrichten, fordert 
     Lift: redaktion, vereinigten, 🗞, auslandsnachrichten, fordert, top-thema, wünscht 
     Score: redaktion, epoch, fordert, times, 🗞, auslandsnachrichten, top-thema 
Topic 12 Top Words:
     Highest Prob: menschen, geht, gut, machen, kommt, einfach, gibt 
     FREX: leute, gut, angst, sagt, glauben, sehen, kommt 
     Lift: wirtschaft, böse, glaube, verlieren, letzte, leute, denke 
     Score: wirtschaft, leute, glauben, angst, denke, machen, gut 
Topic 13 Top Words:
     Highest Prob: telegram, ⚠️, berlin, uhr, unterstützung, kanal, weitere 
     FREX: ⚠️, unterstützung, telegram, demos, samstag, wien, berlin 
     Lift: ⚠️, querdenken, wien, aktion, freitag, stuttgart, telegram 
     Score: ⚠️, telegram, samstag, demos, demo, stuttgart, uhr 
Topic 14 Top Words:
     Highest Prob: liebe, leben, menschen, ❤️, arbeit, zeit, freiheit 
     FREX: liebe, andreas, herzen, kraft, erreichen, lieben, antwort 
     Lift: einzelnen, andreas, morgen, liebe, gestalten, ps, heiko 
     Score: andreas, liebe, grüße, leben, frieden, heiko, herzen 
Topic 15 Top Words:
     Highest Prob: artikel, wahrheit, menschen, lesen, anderen, steht, geht 
     FREX: wahrheit, artikel, demokratie, lesen, angeblich, gott, ddr 
     Lift: angeblich, ddr, wahlen, mainstream, presse, wahrheit, bestimmt 
     Score: angeblich, wahrheit, artikel, gott, ddr, demokratie, wahlen 
Topic 16 Top Words:
     Highest Prob: ➡, ➡️, daten, wochen, studie, zahl, pfizer 
     FREX: ➡, ➡️, daten, pfizer, wochen, studie, ernährung 
     Lift: ➡️, ernährung, ➡, pfizer, todesfälle, daten, schweiz 
     Score: ➡, ➡️, ernährung, pfizer, nebenwirkungen, studie, zahl 

Now, what’s what?

• Highest Prob: words that were assigned the highest probabilities \(\beta\) of belonging to the topic
• FREX: words within a topic that are both frequent and exclusive to this topic (see documentation for calcfrex())
• Lift and Score: similar to FREX, words that are important for this topic, but less important for others (see documentation for calclift() and calcscore())

Ideally, these words should help you to interpret the topics in a meaningful way.

Instead of relying on summary(), you can also extract the per-term-per-topic probabilities \(\beta\) (“beta”) directly, using tidytext’s tidy() function (or, alternatively, FREX or lift words, using matrix = "frex" or matrix = "lift"):

tidy(schwurbel_stm) |>
  arrange(topic, desc(beta))

This allows for nice ggplot visualisations:

tidy(schwurbel_stm) |>
  group_by(topic) |>
  slice_max(beta, n = 10) |>
  ungroup() |>
  ggplot(aes(beta, reorder_within(term, by = beta, within = topic))) +
  geom_col() +
  scale_y_reordered() +
  facet_wrap(vars(topic), scales = "free", labeller = label_both) +
  labs(x = expression(beta),
       y = "term")

If you really want to, you can also visualise individual topics with word clouds:

cloud(schwurbel_stm, topic = 5)

Warning in wordcloud::wordcloud(words = vocab, freq = vec, max.words =
max.words, : impfung could not be fit on page. It will not be plotted.

Which texts are most representative for given topics? Again, you can use the tidy() function to extract per-document-per-topic probabilities \(\gamma\) (“gamma”; stm calls this \(\theta\), “theta”); if these are grouped by topic and arranged by value, you can use them to find the documents most highly associated with individual topics. Let’s have a look at topic 5, for example:

tidy(schwurbel_stm, matrix = "gamma",
     document_names = covariates$id) |>
  filter(topic == 5) |>
  arrange(desc(gamma))

stm’s findThoughts() function does the same thing, but instead of document names, it gives you the n most highly associated texts for each topic in a vector of topics. This allows you to check if your interpretation of a topic’s content based on its top terms is valid.

findThoughts(schwurbel_stm, topics = c(5, 9), meta = covariates, texts = all |> filter(id %in% counts$id) |> pull(text), n = 3)

 Topic 5: 
     "Die Justiz beschäftigt sich auch mit dem Fall einer 26-jährigen Mailänder Zahnarztassistentin, die einige Tage nach der Impfung mit dem Astra Zeneca-Vakzin eine Hirnthrombose erlitten hat. Sie liegt jetzt auf der Intensivstation eines Mailänder Krankenhauses. In Italien laufen derzeit circa ein Dutzend Ermittlungen über Todesfälle, die mit Impfstoffen zum Schutz vor SARS-CoV-2 in Verbindung gebracht werden könnten." ---- Thrombosen, Herzinfarkte und Hirnblutungen sind nach allen gentechnischen Corona-Impfstoffen möglich von 15.3.2021, Dr. Wolfgang Wodarg (www.wodarg.com) Coronaviren und ihre Spikes kommen bei unkomplizierter Infektion nicht ins Blut. Die Immunbarrieren in den oberen Atemwegen verhindern das bei allen leichten Atemwegsinfektionen nicht nur für Coronaviren*. Bei der Injektion von gentechnischen "Impfstoffen" in den Oberarmmuskel wird das jedoch umgangen. Es gibt dann drei mögliche Risiken der Impfungen, die ähnliche schwerwiegende Folgen haben können**: 1. Nach intramuskulärer Injektion muss damit gerechnet werden, dass die genbasierten Impfstoffe in die Blutbahn gelangen und sich im Körper verbreiten können [1]. In solchen Fällen muss sodann damit gerechnet werden, dass die Impfstoffe im Blutkreislauf verteilt und von Endothelzellen aufgenommen werden. Das sind die Zellen, mit denen Blutgefäßwände ausgekleidet sind. Es ist anzunehmen, dass solche Aufnahme in Endothelzellen insbesondere an Stellen mit langsamem Blutfluss, also in kleinen Gefäßen und Kapillaren, geschieht. Wenn das geschieht, werden die genetischen Informationen der Impfstoffe (z.B. mRNA) jene Endothelzellen veranlassen, Teile von Spike-Proteinen zu produzieren und an ihren Oberflächen den vorbeifließenden Blutzellen zu präsentieren. Viele gesunde Personen haben CD8-Lymphozyten, die im Blut patrouillieren und solche Corona-Spike-Peptide erkennen, was auf eine frühere COVID-Infektion, aber auch auf Kreuzreaktionen mit anderen Coronavirus-Typen zurückzuführen sein kann [3; 4] [5]. Wir müssen davon ausgehen, dass diese CD8-Lymphozyten bei Kontakt einen Angriff auf die entsprechenden Zellen starten. Dadurch kann es an unzähligen Stellen im Körper zu Gefäßwandschädigungen mit anschließender Auslösung der Blutgerinnung durch Aktivierung der Blutplättchen (Thrombozyten) kommen. Das geschieht also wenn der Impfstoff selbst ins Blut gelangt. Zwei weitere Risiken entstehen, wenn nicht der Impfstoff mit seinen genetischen Informationen, sondern die von unserem Körper durch ihn induzierten und in useren Zellen selbst hergestellten Spike-Proteine oder Teile davon ins Blut abgegeben werden. 2. Wenn solche gentechnisch in unseren Zellen erzeugten SARS-CoV-2-Spike-Proteine ins Blut gelangen, verbinden sie sich direkt mit den ACE2-Rezeptoren der Thrombozyten, was auch zu Blutverklumpungen und Thrombosen führt [6][7]. Das ist auch bei ganzen Coronaviren, die in seltenen Fällen ins Blut gelangen, beobachtet worden. Bei geimpften Personen wurde auch über so entstandene Thrombozytopenien berichtet [8][9][10]. 3. Hinzu kommt die Fähigkeit der SARS-CoV-2-Spike-Proteine sehr stark Zellfusionen zu initiieren. Die dadurch entstehenden Riesenzellen können ebenfalls zu Gefäßverlegungen, Entzündungsreaktionen und Mikrothrombosen führen.(11) Was kann bei allen drei Ursachen die Folge sein: Bei Blutuntersuchungen kann man das am Abfall der Thrombozytenzahl und am Auftreten von D-Dimeren (Fibrinabbauprodukte) im Blut erkennen. Klinisch kann es zu unzähligen Schäden in Folge von Durchblutungsstörungen im ganzen Körper, einschließlich im Gehirn, Rückenmark und Herz kommen. Wegen eines solchen Verbrauchs von Gerinnungsfaktoren und Blutplättchen können auch Blutungen in verschiedenen Organen auftreten und z.B. im Gehirn tödliche Folgen haben. Wichtig ist: Für alle genannten Möglichkeiten, die zu einer disseminierten intravasalen Gerinnung (DIC) führen können, fehlt bei allen drei Impfstoffen der Nachweis, dass diese vor ihrer Zulassung zur Anwendung am Menschen durch die EMA ausgeschlossen… @WolfgangWodarg
    In dieser Pressekonferenz forderten wir eine rasche und aktualisierte Überprüfung dieser Beweise in der Hoffnung, dass eine Behandlungsempfehlung abgegeben werden kann, die schnell viele tausend Menschenleben rettet. Die Pressekonferenz wurde über Associated Press und Univision in nahezu alle Länder der Welt übertragen. Das Gesundheitsministerium der Regierung von Uganda überprüft derzeit unser Manuskript mit der Absicht, unser Behandlungsprotokoll in eine nationale Behandlungsrichtlinie aufzunehmen. Es ist jetzt 48 Stunden später und obwohl es weit verbreitet ist, haben wir nicht gehört von: • Alle nationalen Nachrichtenradios, Zeitungen oder Fernsehsender. • Jedes einzelne Mitglied einer US-Gesundheitsbehörde. • Eine bemerkenswerte Ausnahme ist das Interesse des Gesundheitsministeriums der Die ugandische Regierung überprüft derzeit unser Manuskript mit der Absicht, unser Behandlungsprotokoll in eine nationale Behandlungsrichtlinie aufzunehmen. Derzeit sind uns keine ähnlichen Bemühungen einer US-Gesundheitsbehörde bekannt. (Dieser Punkt kann bei Bedarf weggelassen werden) Dies ist inakzeptabel, da wir Beweise dafür dokumentiert haben, dass führende Mitglieder der Operation Warp Speed, einschließlich Janet Woodcock, geplant hatten, unsere Pressekonferenz zu verfolgen, ebenso wie mehrere Mitglieder der CDC und des Militärs sowie Journalisten von großen nationalen Nachrichtenagenturen, die zuschauten. Wieder 48 Stunden später und kein Kontakt von einem Gesundheitsbeamten oder einer großen Nachrichtenagentur. Wir hoffen immer noch, bald von der Regierung und den Medien zu hören. Ich werde nun kurz die aufkommenden wissenschaftlichen Daten überprüfen und zusammenfassen, die die Wirksamkeit von Ivermectin bei der Behandlung von COVID-19 belegen Daten, die Ivermectin als potenzielle globale Lösung für die COVID-19-Pandemie unterstützen Ivermectin beseitigt bereits Coronavirus-Infektionen in mehreren Regionen der Welt. Dutzende von Studien belegen die Wirksamkeit von Studien, die von der „Bank bis zum Krankenbett“ durchgeführt wurden, wie folgt: 1) Seit 2012 haben mehrere In-vitro-Studien gezeigt, dass Ivermectin die Replikation vieler Viren, einschließlich Influenza, Zika, Dengue und anderer, hemmt (19-27). 2) Ivermectin hemmt die SARS-CoV-2-Replikation, was dazu führt, dass in infizierten Zellkulturen bis 48 Stunden fast das gesamte virale Material fehlt (28). 3) Ivermectin hat starke entzündungshemmende Eigenschaften, wobei In-vitro-Daten eine tiefgreifende Hemmung sowohl der Zytokinproduktion als auch der Transkription des Kernfaktors κB (NF-κB), des wirksamsten Entzündungsmediators, belegen (29-31). 4) Ivermectin verringert die Viruslast signifikant und schützt in mehreren Tiermodellen vor Organschäden, wenn es mit SARS-CoV-2 oder ähnlichen Coronaviren infiziert wird (32, 33). 5) Ivermectin verhindert die Übertragung und Entwicklung der COVID-19-Krankheit bei Patienten, die infizierten Patienten ausgesetzt sind (34-36,54,88). 6) Ivermectin beschleunigt die Genesung und verhindert eine Verschlechterung bei Patienten mit leichten bis mittelschweren Erkrankungen, die früh nach Symptomen behandelt werden (37-42,54). 7) Ivermectin beschleunigt die Genesung und Vermeidung der Aufnahme auf der Intensivstation und des Todes bei Krankenhauspatienten (40,43,45,54,63,67). 8) Ivermectin reduziert die Mortalität bei kritisch kranken Patienten mit COVID-19 (43, 45, 54). 9) Ivermectin führt in Regionen mit großer Verbreitung zu einer deutlichen Verringerung der Sterblichkeitsrate benutze (46-48). 10) Die Sicherheit von Ivermectin ist aufgrund seiner nahezu Null-Wechselwirkungen nahezu unübertroffen mit nur leichten und seltenen Nebenwirkungen, die in fast 40 Jahren und Milliarden von Jahren beobachtet wurden verabreichte Dosen (49). 11) Die Weltgesundheitsorganisation hat Ivermectin seit langem in ihre „Liste der wesentlichen Elemente“ aufgenommen Arzneimittel “(50).
    Wenn wir so weit gekommen sind, haben wir ein exogenes Viruspartikel vollständig isoliert, charakterisiert und genetisch sequenziert. Wir müssen jedoch noch zeigen, dass es ursächlich mit einer Krankheit zusammenhängt. Dies wird durchgeführt, indem eine Gruppe gesunder Probanden (normalerweise werden Tiere verwendet) diesem isolierten, gereinigten Virus in der Weise ausgesetzt wird, in der angenommen wird, dass die Krankheit übertragen wird. Wenn die Tiere an derselben Krankheit erkranken, wie durch klinische Befunde und Autopsieergebnisse bestätigt, hat man nun gezeigt, dass das Virus tatsächlich eine Krankheit verursacht. Dies zeigt die Infektiosität und Übertragung eines infektiösen Erregers. Keiner dieser Schritte wurde mit dem SARS-CoV-2-Virus versucht, noch wurden alle diese Schritte erfolgreich für ein sogenanntes pathogenes Virus durchgeführt. Unsere Forschung zeigt, dass eine einzige Studie, die diese Schritte zeigt, in der medizinischen Literatur nicht existiert. Stattdessen haben Virologen seit 1954 ungereinigten Proben von relativ wenigen Menschen, oft weniger als zehn, mit einer ähnlichen Krankheit entnommen. Anschließend verarbeiten sie diese Probe minimal und impfen diese ungereinigte Probe in eine Gewebekultur, die normalerweise vier bis sechs andere Arten von Material enthält - alle enthalten identisches genetisches Material wie das sogenannte „Virus“. Die Gewebekultur ist ausgehungert und vergiftet und zerfällt auf natürliche Weise in viele Arten von Partikeln, von denen einige genetisches Material enthalten. Gegen jeden gesunden Menschenverstand, jede Logik, jeden Gebrauch der englischen Sprache und jede wissenschaftliche Integrität wird dieser Prozess als "Virusisolation" bezeichnet. Dieses Gebräu, das Fragmente von genetischem Material aus vielen Quellen enthält, wird dann einer genetischen Analyse unterzogen, die dann in einem Computersimulationsprozess die angebliche Sequenz des angeblichen Virus erzeugt, ein sogenanntes silico-Genom . Zu keinem Zeitpunkt wird ein tatsächliches Virus durch Elektronenmikroskopie bestätigt. Zu keinem Zeitpunkt wird ein Genom aus einem tatsächlichen Virus extrahiert und sequenziert. Das ist wissenschaftlicher Betrug. Die Beobachtung, dass die ungereinigte Probe - zusammen mit toxischen Antibiotika, fötalem Rindergewebe, Fruchtwasser und anderen Geweben in Gewebekultur geimpft - das Nierengewebe zerstört, auf das sie geimpft wurde, wird als Beweis für die Existenz und Pathogenität des Virus gegeben. Das ist wissenschaftlicher Betrug. Wenn Ihnen von nun an jemand ein Papier gibt, das darauf hinweist, dass das SARS-CoV-2-Virus isoliert wurde, lesen Sie bitte die Methodenabschnitte. Wenn die Forscher Vero-Zellen oder eine andere Kulturmethode verwendeten, wissen Sie, dass ihr Prozess keine Isolierung war. Sie werden die folgenden Ausreden hören, warum die eigentliche Isolation nicht erfolgt: In Proben von Patienten wurden nicht genügend Viruspartikel gefunden, um sie zu analysieren. Viren sind intrazelluläre Parasiten; Sie können auf diese Weise nicht außerhalb der Zelle gefunden werden. Wenn Nr. 1 richtig ist und wir das Virus nicht im Auswurf kranker Menschen finden können, nach welchen Beweisen halten wir das Virus dann für gefährlich oder sogar tödlich? Wenn Nr. 2 richtig ist, wie verbreitet sich das Virus dann von Person zu Person? Uns wird gesagt, dass es aus der Zelle kommt, um andere zu infizieren. Warum ist es dann nicht möglich, es zu finden? Schließlich ist das Hinterfragen dieser virologischen Techniken und Schlussfolgerungen keine Ablenkung oder ein Streitpunkt. Das Licht auf diese Wahrheit zu werfen ist wichtig, um diesen schrecklichen Betrug zu stoppen, mit dem die Menschheit konfrontiert ist. Denn wie wir jetzt wissen, wenn das Virus nie isoliert, sequenziert oder krankheitsverursacht wurde, wenn das Virus imaginär ist, warum tragen wir dann Masken, soziale Distanzierung und bringen die ganze Welt ins Gefängnis? 
 Topic 9: 
     "Masken werden von Kindern akzeptiert": Prof. Wieland Kiess, Direktor der Klinik für Kinder- und Jugendmedizin am Uniklinikum Leipzig. Dass Kinder ein Problem mit dem Maskentragen haben, sei falsch. "Schon meine eineinhalb- und dreijährige Enkelinnen fragen wie selbstverständlich nach der Maske", sagt Kiess. "Das Problem liegt bei den Eltern." Maske auf - so ist's richtig: Hinter einem Kind ohne Mundschutz steckt oft eine psychisch auffällige Mutter. Auch mit seinen Ärztekollegen, die im Wartezimmer Plakate mit der Maske als "Symbol der Unterdrückung" aufhängen, geht Prof. Kiess hart ins Gericht: "Die Landesärztekammer müsste ihnen die Approbation entziehen." Das Feudalherrensystem der Kliniken offenbart sich mal wieder: Evidenz ist die Meinung des Chefarztes, nicht die Datenlage. Natürlich kann ein Kinderarzt (!) sich auch ganz selbstverständlich zur Psychopathologie der Eltern (!) ´fachmännisch´ äußern - ohne, dass ein Journalist nachhakt. Nach OPD (Operationalsierten Psychodynamischen Diagnostik) werden bei Erwachsenen 7 verschiedene Niveaus der Abwehrmechanismen unterschieden: Die Abwehrmechanismen (nach psychischen Struktur-/Funktionsniveau) Projektion (Hinter einem Kind ohne Mundschutz steckt oft eine psychisch auffällige Mutter) und Verleugnung (der Datenlage), gehören dabei zum 4/7 also schon recht niedrigen Funktionsniveau: das Verleugnungsniveau. Merkmale: unangenehme oder unannehmbare Belastungsfaktoren, Impulse, Vorstellungen, Affekte oder Verantwortung werden außerhalb des Bewußtseins gehalten. Sie können mit oder ohne Fehlattribution auf äußere Ursachen einhergehen. Der Abwehrmechanismus der Spaltung des Selbstbildes und des Bildes von anderen (mit seinen Ärztekollegen, die im Wartezimmer Plakate mit der Maske als "Symbol der Unterdrückung" aufhängen, geht Prof. Kiess hart ins Gericht: "Die Landesärztekammer müsste ihnen die Approbation entziehen.") ist sogar noch ein psychisches Struktur Niveau tiefer: Niveau mit schwerer Vorstellungsverzerrung, gekennzeichnet durch grobe Verzerrung oder Fehlattribution des Selbstbildes oder des Bildes von anderen. (OPD S.483f). Sicher wurde Prof. K. in diesem Leipziger Blättchen falsch zitiert, auch wenn das ängstlich-gestresste Gesichtsausdruck durchaus zu den Aussagen passen würde....aber Ferndiagnosen macht man nicht. Naja, bis auf die Gutachter im Richtlinien Psychotherapieverfahren (Kassenpatienten), die Psychotherapiekontingente für PatientInnen ablehnen können - an Hand eines Berichtes (!), der vom behandelten Psychotherapeuten zur Beantragung der Psychotherapiestunden eingesendet werden muß: Ablehnung einer Psychotherapie ist in DE möglich, ohne den Patienten jemals gesehen zu haben. Die Honorare der Gutachter belaufen sich in etwa auf die gleiche Höhe, wie die alle abgelehnten Psychotherapien. Dh Gutachter einzusetzen, die Therapien ablehen, bringt unter dem Strich keine Ersparnis für die Kassen, führt aber dazu, dass weniger Patienten eine Therapie bekommen. Interessant auch: die Ablehnungsrate schwankt zwischen 1-10% je Gutachter. URL
    Dr. Wolfgang Wodarg Die bayerische Staatsregierung hatte in der vergangenen Woche mehrfach von fast doppelt so vielen beatmeten Patientinnen und Patienten gesprochen, als es sie tatsächlich gab in Bayern. "Nach BR-Recherchen werden nur halb so viele Corona-Patienten beatmet, wie offiziell angegeben. Die Ursache hierfür liegt in unterschiedlichen Statistiken und einer fehlerhaften Interpretation." ;-) Media Zahlen der Staatsregierung sorgen für Verwirrung: Nach BR-Recherchen werden nur halb so viele Corona-Patienten beatmet, wie offiziell angegeben. Die Ursache hierfür liegt in unterschiedlichen Statistiken und einer fehlerhaften Interpretation. (Feed generated with FetchRSS) via Dr. Wolfgang Wodarg on Facebook URL @WolfgangWodarg
    Heutzutage müssen Kinder vor der Schule beschützt werden. Unglaublich, was sie den Kindern antun. Folgendes hat eine ehemalige Waldorflehrerin zugesendet. Eltern für Aufklärung und Freiheit URL Wer sind wir? Wir sind Eltern, Großeltern, Erzieher und Lehrer. Wir setzen uns für die freie Entfaltung unserer Kinder ein, frei von Zwangsmaßnahmen, die mit der derzeitigen Corona-Situation begründet werden. Wir wünschen uns mehr Entscheidungsfreiheit für alles, was unsere Kinder betrifft. Wir haben uns zum Ziel gesetzt unsere Kinder vor staatlicher Willkür zu schützen. Was möchten wir? Wir verbinden Eltern, Großeltern, Pädagogen und Mediziner. Unsere Bewegung soll wachsen und dafür brauchen wir Euch. Gemeinsam sind wir noch stärker. Wir möchten darüber aufklären, wie es zu der Situation kam, in der sich unsere Kinder befinden. Wir wünschen den Diskurs. Wir setzen uns ganz konkret für die Situation unserer Kinder in den Schulen, Kindergärten, Sport- und Musikvereinen in dieser außergewöhnlichen Zeit ein. Wir wollen die Regierung dazu bringen, endlich für das Wohl der Kinder zu handeln. Wir fordern ganz klar: - keine übertriebenen Hygienemaßnahmen - keine soziale Distanz - keine Masken - normalen Schulunterricht: Kinder brauchen Bildung ohne Einschränkungen - normalen Kindergarten: Kinder brauchen Freunde, Nähe und Freizeit mit Gleichaltrigen Kommt zu uns zum Vernetzen, wir und unsere Kinder brauchen Euch. Unsere Landesgruppen und Ortsgruppen findest du auf: Landesgruppen: URL - Baden-Württemberg URL - Bayern URL - Berlin URL - Brandenburg URL - Brandenburg URL - Hamburg URL - Hessen URL - Mecklenburg-Vorpommern URL - Niedersachsen URL - Nordrhein-Westfalen URL - Rheinland-Pfalz URL - Saarland URL - Sachsen URL - Sachsen-Anhalt URL - Schleswig-Holstein URL - Thüringen Ortsgruppen: PLZ0 URL PLZ1 URL PLZ2 URL PLZ3 URL PLZ4 URL PLZ5 URL PLZ6 URL PLZ7 URL PLZ8 URL PLZ9 URL

The stm package has its own plot function (?plot.STM) which is quite versatile. By default, it shows the topics arranged by their (expected) relative frequency in the corpus:

plot(schwurbel_stm, labeltype = "frex")

Setting type to "perspectives", we can contrast two topics by their n most important words:

plot(schwurbel_stm, type = "perspectives", topics = c(5, 9), n = 30)

Finally, setting type to "hist", we get histograms of topic loadings (per-document-per-topic probabilities \(\gamma\)) across documents (“MAP” stands for “maximum a posteriori”). As a reminder, a document topic loading tells us how strongly a given document is associated with a given topic. The histogram of these document topic loadings then shows us the proportions of documents with different loadings. The median is shown as a dashed red line.

plot(schwurbel_stm, type = "hist", labeltype = "frex")

Again, we can recreate this using ggplot, although it might be slightly more work:

topic_words <- tidy(schwurbel_stm, matrix = "frex") |>
  group_by(topic) |>
  slice_head(n = 5) |>
  reframe(term = str_c(term, collapse = ", "))
tidy(schwurbel_stm, matrix = "gamma") |>
  group_by(topic) |>
  mutate(median_gamma = median(gamma)) |>
  left_join(topic_words, by = "topic") |>
  ggplot(aes(x = gamma)) +
  geom_histogram(binwidth = .05, boundary = 0) +
  geom_vline(aes(xintercept = median_gamma), linetype = "dashed", colour = "red") +
  facet_wrap(vars(topic, term)) +
  labs(x = expression(gamma))

Of course, we can also recreate the “top topics” plot from above:

tidy(schwurbel_stm, matrix = "gamma") |>
  group_by(topic) |>
  summarise(mean = mean(gamma)) |>
  arrange(desc(mean)) |>
  left_join(topic_words, by = "topic") |>
  ggplot(aes(x = mean, y = as.character(topic) |> fct_inorder() |> fct_rev())) +
  geom_col() +
  xlim(c(0, .18)) +
  geom_label(aes(label = term), hjust = "left", nudge_x = .002) +
  labs(title = "Top topics", y = "topic", x = "expected relative frequency")

Correlations between topics

Since topics can be correlated in a STM, it might be interesting to see which topics often appear together.

Correlation matrix:

topicCorr(schwurbel_stm)$cor

             [,1]        [,2]        [,3]        [,4]        [,5]        [,6]
 [1,]  1.00000000 -0.03841324 -0.06335998 -0.01368451 -0.08073216 -0.10039403
 [2,] -0.03841324  1.00000000 -0.07603897 -0.02774086 -0.07841778 -0.09006067
 [3,] -0.06335998 -0.07603897  1.00000000 -0.05855263 -0.09356869  0.00000000
 [4,] -0.01368451 -0.02774086 -0.05855263  1.00000000 -0.06347463 -0.08209510
 [5,] -0.08073216 -0.07841778 -0.09356869 -0.06347463  1.00000000  0.11931573
 [6,] -0.10039403 -0.09006067  0.00000000 -0.08209510  0.11931573  1.00000000
 [7,] -0.03318563 -0.04686988 -0.06792448 -0.03816238 -0.14117541 -0.15315173
 [8,] -0.10158106 -0.05258469  0.00000000 -0.09618646 -0.15196266 -0.03284762
 [9,]  0.03570217 -0.05660607 -0.08684215 -0.04639331  0.01207779 -0.01606818
[10,] -0.03195055 -0.03418571 -0.09661155  0.09840649 -0.07751467 -0.09545586
[11,] -0.01326511 -0.03534601 -0.07336557 -0.04697723 -0.07540393 -0.11363977
[12,] -0.07842545 -0.11320231 -0.06781443 -0.11501374 -0.08422171 -0.09996483
[13,] -0.05019233 -0.05969215 -0.05627567 -0.02841698 -0.16163440 -0.05961545
[14,] -0.06364336 -0.08484334 -0.07853860 -0.07790720 -0.19370240 -0.11184520
[15,] -0.08432323 -0.09408993  0.05148411 -0.06760493 -0.16556966 -0.09272955
[16,] -0.04780064 -0.05361928 -0.09603947 -0.02309630  0.10223914 -0.06679632
             [,7]        [,8]        [,9]       [,10]       [,11]       [,12]
 [1,] -0.03318563 -0.10158106  0.03570217 -0.03195055 -0.01326511 -0.07842545
 [2,] -0.04686988 -0.05258469 -0.05660607 -0.03418571 -0.03534601 -0.11320231
 [3,] -0.06792448  0.00000000 -0.08684215 -0.09661155 -0.07336557 -0.06781443
 [4,] -0.03816238 -0.09618646 -0.04639331  0.09840649 -0.04697723 -0.11501374
 [5,] -0.14117541 -0.15196266  0.01207779 -0.07751467 -0.07540393 -0.08422171
 [6,] -0.15315173 -0.03284762 -0.01606818 -0.09545586 -0.11363977 -0.09996483
 [7,]  1.00000000 -0.08424740 -0.10831983 -0.04050925 -0.03164409 -0.09504466
 [8,] -0.08424740  1.00000000 -0.12365019 -0.11476084  0.00000000  0.00000000
 [9,] -0.10831983 -0.12365019  1.00000000 -0.05607301 -0.07616030 -0.06802686
[10,] -0.04050925 -0.11476084 -0.05607301  1.00000000 -0.06066366 -0.11424239
[11,] -0.03164409  0.00000000 -0.07616030 -0.06066366  1.00000000 -0.11607562
[12,] -0.09504466  0.00000000 -0.06802686 -0.11424239 -0.11607562  1.00000000
[13,] -0.08939783 -0.07604526 -0.07887240 -0.06679145 -0.07008068 -0.19094005
[14,] -0.04472001 -0.05282813 -0.07775971 -0.04980530 -0.11756558  0.11735834
[15,] -0.04665349 -0.06958533 -0.11758250 -0.09677100 -0.11388158  0.09942412
[16,] -0.08045449 -0.09260490 -0.04063107 -0.05272638  0.00000000 -0.19763478
            [,13]       [,14]       [,15]       [,16]
 [1,] -0.05019233 -0.06364336 -0.08432323 -0.04780064
 [2,] -0.05969215 -0.08484334 -0.09408993 -0.05361928
 [3,] -0.05627567 -0.07853860  0.05148411 -0.09603947
 [4,] -0.02841698 -0.07790720 -0.06760493 -0.02309630
 [5,] -0.16163440 -0.19370240 -0.16556966  0.10223914
 [6,] -0.05961545 -0.11184520 -0.09272955 -0.06679632
 [7,] -0.08939783 -0.04472001 -0.04665349 -0.08045449
 [8,] -0.07604526 -0.05282813 -0.06958533 -0.09260490
 [9,] -0.07887240 -0.07775971 -0.11758250 -0.04063107
[10,] -0.06679145 -0.04980530 -0.09677100 -0.05272638
[11,] -0.07008068 -0.11756558 -0.11388158  0.00000000
[12,] -0.19094005  0.11735834  0.09942412 -0.19763478
[13,]  1.00000000 -0.05450791 -0.10623895 -0.06798268
[14,] -0.05450791  1.00000000  0.00000000 -0.16272889
[15,] -0.10623895  0.00000000  1.00000000 -0.13167911
[16,] -0.06798268 -0.16272889 -0.13167911  1.00000000

Visualised:

topicCorr(schwurbel_stm) |> plot()

Since this doesn’t include correlation size, it’s arguably not that informative. But we can easily create our own visualisation:

library(igraph)
library(tidygraph)
library(ggraph)
nw <- graph_from_adjacency_matrix(topicCorr(schwurbel_stm)$poscor, # only positive correlations
                                  diag = FALSE,
                                  weighted = TRUE,
                                  mode = "undirected")
nw_tbl <- nw |> as_tbl_graph()
nw_tbl <- nw_tbl |>
  mutate(topic = 1:n())
nw_tbl |>
  ggraph(layout = "igraph", algorithm = "circle") +
  geom_node_point(size = 2,
                  colour = "#008855") +
  geom_node_text(aes(label = topic),
                 nudge_y = -.08) +
  geom_edge_arc(aes(alpha = weight,
                    label = round(weight, 2)),
                label_alpha = NA,
                label_dodge = unit(2.5, "mm"),
                label_size = 3,
                angle_calc = 'along') +
  theme_graph() +
  theme(legend.position = "none")

Estimating effects

The estimateEffect() function can be used to quickly create regression models in which the dependent variable is the proportion of an individual topic in each document. Independent variables/covariates can be any kind of document-level metadata. In this case, let’s see if there are topics whose proportions differ significantly between Geschwurbel and non-Geschwurbel posts. (One thing to keep in mind is that the function incorporates uncertainty from the topic model and some sampling, making it a little more complicated than simple linear regression; this also means that you’ll get slightly different results every time you run the code.)

schwurbel_effect <- estimateEffect(1:16 ~ Geschwurbel, schwurbel_stm, meta = covariates)
schwurbel_effect |> summary(topics = 1:16)

Call:
estimateEffect(formula = 1:16 ~ Geschwurbel, stmobj = schwurbel_stm, 
    metadata = covariates)


Topic 1:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.033292   0.005504   6.049    2e-09 ***
Geschwurbelnein 0.001831   0.007740   0.237    0.813    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 2:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.024183   0.005767   4.194 2.97e-05 ***
Geschwurbelnein -0.002952   0.008033  -0.367    0.713    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 3:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.071699   0.006332  11.323   <2e-16 ***
Geschwurbelnein -0.005411   0.008217  -0.658     0.51    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 4:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.020792   0.004418   4.706 2.85e-06 ***
Geschwurbelnein -0.002034   0.006120  -0.332     0.74    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 5:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.095699   0.008827   10.84   <2e-16 ***
Geschwurbelnein -0.024332   0.011985   -2.03   0.0426 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 6:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.076746   0.007176  10.695   <2e-16 ***
Geschwurbelnein 0.003613   0.009623   0.375    0.707    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 7:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.070089   0.007440   9.420  < 2e-16 ***
Geschwurbelnein -0.032437   0.009952  -3.259  0.00115 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 8:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.086151   0.007915  10.884   <2e-16 ***
Geschwurbelnein 0.003334   0.010288   0.324    0.746    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 9:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.050176   0.006686   7.504 1.27e-13 ***
Geschwurbelnein 0.014591   0.009421   1.549    0.122    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 10:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.034080   0.006393   5.331 1.19e-07 ***
Geschwurbelnein -0.005225   0.008758  -0.597    0.551    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 11:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.029919   0.006201   4.825  1.6e-06 ***
Geschwurbelnein 0.027349   0.008449   3.237  0.00125 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 12:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.130033   0.007952  16.353  < 2e-16 ***
Geschwurbelnein -0.037745   0.010283  -3.671 0.000254 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 13:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.05305    0.00884   6.001 2.65e-09 ***
Geschwurbelnein  0.05787    0.01212   4.776 2.03e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 14:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.080879   0.007250  11.155   <2e-16 ***
Geschwurbelnein 0.003148   0.010304   0.306     0.76    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 15:

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      0.098187   0.007435  13.206   <2e-16 ***
Geschwurbelnein -0.015752   0.010551  -1.493    0.136    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Topic 16:

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     0.045286   0.007146   6.338  3.4e-10 ***
Geschwurbelnein 0.014086   0.009812   1.436    0.151    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

tidy() can be used to get all of this as a tibble:

tidy(schwurbel_effect)

Apparently, topics 5 (‘vaccination’), 7 (‘QAnon’) and 12 (?) are significantly more likely to contain Geschwurbel, whereas topics 11 (‘Epoch Times newsticker’) and 13 (‘information about COVID-19 protests’?; possibly semantically incoherent) are more likely to not contain Geschwurbel.

You can also plot() the results in different ways (?plot.estimateEffect):

par(mar = c(5.1, 9.1, 4.1, 2.1))
schwurbel_effect |>
  plot("Geschwurbel", method = "difference", cov.value1 = "ja", cov.value2 = "nein")

par(mar = c(5.1, 4.1, 4.1, 2.1)) # default values

Trying and comparing different numbers of topics

Since we usually don’t (and can’t) know the ideal number of topics in our model beforehand, it makes sense to run and explore models with different values of K. But how do we then determine which of them is “best”?

Topics can be “bad” in different ways:

• they can appear wholly random
• they can cluster words together which are not related in a meaningful way (e.g. function words or foreign language material)
• they can include some terms that do not quite fit the topic’s apparent core concept (“intruder” words)
• they can combine two or more distinct topics in one
• they can be too specific and thus fail to detect a more general topic

Given enough time, we could go through the topics of each model to find out which model seems to make the most sense overall. But if we want to consider many different values of K, that’s probably unrealistic. Instead, we can use a variety of model diagnostics to evaluate and compare models.

Semantic coherence

Semantic coherence is intended to measure how well a topic’s top M words fit together. “The core idea here is that in models which are semantically coherent the words which are most probable under a topic should co-occur within the same document.” (?semanticCoherence) The closer to zero the value for a topic, the more coherent it is.

tibble(topic = factor(1:16),
       semantic_coherence = semanticCoherence(schwurbel_stm, docs, M = 10)) |>
  ggplot(aes(x = topic, y = semantic_coherence)) +
  geom_col()

Exclusivity

The documentation notes that “semantic coherence alone is relatively easy to achieve by having only a couple of topics which all are dominated by the most common words”. To counteract this possible problem, the top words of a topic should not appear within the top words of another topics – in other words, they should be exclusive to a single topic (cf. Roberts et al. 2014. For each topic, the exclusivity() function returns the sum of the FREX values (between 0 and 1) of its M top words. The maximum value is then equal to M. Lower values indicate lower exclusivity.

In our case, there’s not much to see here:

tibble(topic = factor(1:16),
       exclusivity = exclusivity(schwurbel_stm, M = 10, frexw = .7)) |> # frexw: weight for exclusivity (between 0 and 1); weight for frequency is 1 - frexw
  ggplot(aes(x = topic, y = exclusivity)) +
  geom_col()

Residual dispersion

Taddy (2012) proposed a diagnostic method based on residuals. The documentation for checkResiduals() has this to say:

The basic idea is that when the model is correctly specified the multinomial likelihood implies a dispersion of the residuals: \(\sigma^2 = 1\). If we calculate the sample dispersion and the value is greater than one, this implies that the number of topics is set too low, because the latent topics are not able to account for the overdispersion. In practice this can be a very demanding criterion, especially if the documents are long. However, when coupled with other tools it can provide a valuable perspective on model fit.

So, lower values are better, and values greater than one imply that you should try models with more topics. In our case, however, this criterion doesn’t appear to be very helpful (see graph in next section).

checkResiduals(schwurbel_stm, docs)

$dispersion
[1] 1.592185

$pvalue
[1] 0

$df
[1] 455798

Going through a range of topic numbers

The searchK() function automatically computes topic models for a given vector of topic numbers (this may take a lot of time, depending on the size of the document-term matrix and the length of the vector). You can then use plot() on the resulting object to see comparisons of (averages of) different diagnostics to help you choose the most adequate model. Don’t rely too heavily on these, however – even with very good stats, a model can still be nonsense.

The results also include values for heldout likelihood. The idea here “is to hold out some fraction of the words in a set of documents, train the model and use the document-level latent variables to evaluate the probability of the heldout portion” (the higher, the better; see ?make.heldout).

different_k <- searchK(dfm,
                       K = seq(4, 40, by = 4), # number of topics (4, 8, 12, ..., 40)
                       N = floor(.1 * nrow(covariates)), # number of documents to be partially held out
                       data = covariates,
                       prevalence = ~ channel,
                       init.type = "Spectral",
                       verbose = FALSE) # set to TRUE to see status updates

different_k$results |> map(unlist) |> as_tibble()

plot(different_k)

Model outputs as features for supervised classification

The per-document-per-topic probabilities \(\gamma\) can be used as features for classification models. You simply need them in a feature matrix with one document per row and one topic per column:

feats <- tidy(schwurbel_stm, matrix = "gamma", document_names = covariates$id) |>
  pivot_wider(names_from = "topic", values_from = "gamma", names_prefix = "topic_")

feats <- covariates |> left_join(feats, by = c("id" = "document"))

feats

Here’s a quick demonstration using logistic regression. Of course, in practice, you should train the model on the training set and evaluate on the test set.

feats |>
  select(Geschwurbel:last_col()) |>
  glm(Geschwurbel ~ ., data = _,
      family = "binomial") |>
  summary()

Call:
glm(formula = Geschwurbel ~ ., family = "binomial", data = select(feats, 
    Geschwurbel:last_col()))

Coefficients: (1 not defined because of singularities)
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  0.78905    0.45115   1.749 0.080296 .  
topic_1     -0.75926    0.72054  -1.054 0.291998    
topic_2     -0.97210    0.64455  -1.508 0.131507    
topic_3     -1.18924    0.68222  -1.743 0.081302 .  
topic_4     -1.03115    0.77984  -1.322 0.186079    
topic_5     -1.83616    0.66171  -2.775 0.005522 ** 
topic_6     -0.47674    0.64131  -0.743 0.457251    
topic_7     -2.19651    0.63080  -3.482 0.000498 ***
topic_8     -0.45691    0.62866  -0.727 0.467355    
topic_9      0.49255    0.69135   0.712 0.476189    
topic_10    -0.93780    0.65447  -1.433 0.151886    
topic_11     1.43618    0.81335   1.766 0.077435 .  
topic_12    -2.27820    0.59718  -3.815 0.000136 ***
topic_13     1.69772    0.65537   2.590 0.009584 ** 
topic_14     0.08396    0.62259   0.135 0.892720    
topic_15    -1.07522    0.62221  -1.728 0.083974 .  
topic_16          NA         NA      NA       NA    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1519.5  on 1097  degrees of freedom
Residual deviance: 1412.5  on 1082  degrees of freedom
AIC: 1444.5

Number of Fisher Scoring iterations: 4

Further resources

• Basic introduction to topic modelling by Silge/Robinson
• Deeper explanation of LDA (with R code) by Tufts
• Chapter on topic modelling by Puschmann/Haim
• Tutorial on topic modelling by Hase